home *** CD-ROM | disk | FTP | other *** search
/ PC-Blue - MS DOS Public Domain Library / PC-Blue MS-DOS Public Domain Library - NYACC.iso / vol033 / plot.bas < prev    next >
Encoding:
BASIC Source File  |  1987-01-11  |  6.4 KB  |  197 lines
  1. 8000 REM  screen plot program
  2. 8010 '    for up to 5 sets of x and y variables
  3. 8020 '    Cybersoft Group - Deane  Wang - April 1982
  4. 8030 '
  5. 8035 KEY OFF
  6. 8040 CLS: CLEAR: SCREEN 0,0,0: OPTION BASE 1
  7. 8050 DEFINT I: DIM OX(5,100), OY(5,100), IX(5,100), IY(5,100), T(20)
  8. 8060 '
  9. 8070 PRINT:PRINT "PLOTTING PROGRAM FOR IBM-PC AND EPSON PRINTER WITH GRAFTRAX OPTION"
  10. 8080 PRINT:PRINT "REQUIRES PRTSC.EXE ON THE SAME DISK"
  11. 8090 PRINT:PRINT: COLOR 0,7
  12. 8100 PRINT:PRINT,"BY CYBERSOFT GROUP - VERSION 11/82               "
  13. 8105 LOCATE 24,32: PRINT"by Deane Wang";:COLOR 7,0
  14. 8110 FOR ZZ=1 TO 2: SOUND 200,20: NEXT ZZ: CLS
  15. 8120 PRINT"THIS PROGRAM REQUIRES INPUTS OF:":PRINT
  16. 8130 PRINT"  THE NUMBER OF COLUMNS OF DATA    (MAX 10 FOR X/Y PAIRS, 6 WITH ONE X"
  17. 8140 PRINT"  THE NUMBER OF ROWS OF DATA       (MAX 100)"
  18. 8150 PRINT:PRINT:PRINT"ALL THE COLUMNS OF DATA NEED NOT BE PLOTTED":PRINT:PRINT
  19. 8160 GOSUB 8290   'read in data
  20. 8170 GOSUB 8700    'min/max subroutine
  21. 8180 GOSUB 8930    'scaling subroutine
  22. 8190 GOSUB 9130   'bubble sort on x
  23. 8200 GOSUB 9320   'label screen
  24. 8210 GOSUB 9730   'plot data
  25. 8220 D$=INKEY$: IF D$="" THEN GOTO 8220 ELSE CLS
  26. 8230 'INPUT "do you want to plot another set in the same dataset";Q$
  27. 8240 'IF Q$="Y" OR Q$="y" THEN FLAG=1
  28. 8242 'IF YCOL$="Y" OF YCOL$="y" THEN GOSUB 8530 ELSE GOSUB 8420: GOSUB 8810:GOTO 8180
  29. 8250 INPUT "do you want to plot another graph";Q$
  30. 8260 IF Q$="Y" OR Q$="y" THEN CLOSE: GOTO 8040
  31. 8270 CLOSE: SYSTEM
  32. 8280 '
  33. 8290 REM  input subroutine
  34. 8300 '
  35. 8310 INPUT "enter filename of data to be plotted";NA$
  36. 8320 OPEN NA$ FOR INPUT AS #1
  37. 8330 INPUT "enter number of data points, (100 max)";IM$
  38. 8340 IF IM$="" THEN GOTO 8330
  39. 8350 IMX=VAL(IM$): IF IMX>100 THEN IMX=100
  40. 8360 IF IMX<3 THEN PRINT "Dataset is too small": GOTO 8310
  41. 8370 INPUT "enter number of columns in the dataset";ICOL
  42. 8380 INPUT "do the data use one set of x values (Y or N)";QCOL$
  43. 8390 IF QCOL$="y" OR QCOL$="Y" THEN GOTO 8530 ELSE GOTO 8400
  44. 8400 INPUT "enter the number of x/y sets in the data";YNUM
  45. 8410 FOR I=1 TO YNUM
  46. 8420 INPUT "enter the column number for x(i) - (y assumed to be next column)";XCOL(I)
  47. 8430 NEXT I:IF FLAG THEN RETURN
  48. 8440 FOR I=1 TO IMX
  49. 8450   FOR IT=1 TO ICOL: IF EOF(1) THEN GOTO 8670 ELSE INPUT#1,T(IT): NEXT IT
  50. 8460   FOR IN=1 TO YNUM
  51. 8470     OX(IN,I)=T(XCOL(IN))
  52. 8480     OY(IN,I)=T(XCOL(IN)+1): PRINT OX(IN,I);OY(IN,I);"<>";
  53. 8490   NEXT IN:PRINT
  54. 8500 NEXT I
  55. 8510 IND=IMX: GOTO 8680
  56. 8520 '
  57. 8530 INPUT "enter the column number for x";XCOL
  58. 8540 INPUT "enter the number of y variables";YNUM
  59. 8550 FOR I=1 TO YNUM: PRINT "enter the column number for y -";I;
  60. 8560 INPUT YCOL(I): NEXT I:IF FLAG THEN RETURN
  61. 8570 FOR I=1 TO IMX
  62. 8580   FOR IT=1 TO ICOL: IF EOF(1) THEN GOTO 8670 ELSE INPUT#1,T(IT): NEXT IT
  63. 8590 FOR K=1 TO ICOL: PRINT T(K);"<>";: NEXT K: PRINT
  64. 8600   FOR IXN=1 TO YNUM: OX(IXN,I)=T(XCOL): NEXT IXN
  65. 8610     FOR IJ=1 TO YNUM
  66. 8620     OY(IJ,I)=T(YCOL(IJ))
  67. 8630     NEXT IJ
  68. 8640 NEXT I
  69. 8650 IND=IMX: GOTO 8680
  70. 8660 '
  71. 8670 IND=I-1   ' number of points per variable
  72. 8680 IN=YNUM: RETURN
  73. 8690 '
  74. 8700 REM  min/max subroutine
  75. 8710 '
  76. 8720 XMN=999999!: XMX=-999999!: YMN=999999!: YMX=-999999!
  77. 8730 FOR IJ=1 TO IN
  78. 8740 FOR I=1 TO IND
  79. 8750 IF XMN>OX(IJ,I) THEN XMN=OX(IJ,I)
  80. 8760 IF YMN>OY(IJ,I) THEN YMN=OY(IJ,I)
  81. 8770 IF XMX<OX(IJ,I) THEN XMX=OX(IJ,I)
  82. 8780 IF YMX<OY(IJ,I) THEN YMX=OY(IJ,I)
  83. 8790 NEXT I
  84. 8800 NEXT IJ
  85. 8810 PRINT: PRINT "x minimum is";XMN
  86. 8820 PRINT "x maximum is";XMX
  87. 8830 PRINT "y minimum is";YMN
  88. 8840 PRINT "y maximum is";YMX
  89. 8850 Q$="n": INPUT "type y to set new values, press <enter> to use defaults";Q$
  90. 8860 IF Q$="y" OR Q$="Y" THEN GOTO 8870 ELSE GOTO 8910
  91. 8870 PRINT: INPUT "x minumum";XMN
  92. 8880 INPUT "x maximum";XMX
  93. 8890 INPUT "y minimum";YMN
  94. 8900 INPUT "y maximum";YMX
  95. 8910 RETURN
  96. 8920 '
  97. 8930 REM  Scaling subroutine
  98. 8940 '
  99. 8950 XRAN=XMX-XMN
  100. 8960 XSC=XRAN/560
  101. 8970 YRAN=YMX-YMN
  102. 8980 YSC=YRAN/160
  103. 8990 FOR IJ=1 TO IN
  104. 9000 FOR I=1 TO IND
  105. 9010 IX(IJ,I)=(OX(IJ,I)-XMN)/XSC
  106. 9020 IF IX(IJ,I)>560 THEN IX(IJ,I)=560
  107. 9030 IF IX(IJ,I)<0 THEN IX(IJ,I)=0
  108. 9040 IX(IJ,I)=IX(IJ,I)+68   'offset for drawn y-axis
  109. 9050 IY(IJ,I)=(OY(IJ,I)-YMN)/YSC
  110. 9060 IF IY(IJ,I)>160 THEN IY(IJ,I)=160
  111. 9070 IF IY(IJ,I)<0 THEN IY(IJ,I)=0
  112. 9080 IY(IJ,I)=164-IY(IJ,I)  'reversal and offset from x-axis
  113. 9090 NEXT I
  114. 9100 NEXT IJ
  115. 9110 RETURN
  116. 9120 '
  117. 9130 REM  Sorting subroutine
  118. 9140 '             a bubble sort in the x-dimension
  119. 9150 '
  120. 9160 PRINT: INPUT "Do the data need sorting (Y or N)"; Q$
  121. 9170 IF Q$="Y" OR Q$="y" THEN GOTO 9180 ELSE GOTO 9300
  122. 9180 FOR IJ=1 TO IN
  123. 9190 IPAS=1
  124. 9200 WHILE IPAS
  125. 9210   IPAS=0
  126. 9220 FOR I=1 TO (IND-1)
  127. 9230   IF IX(IJ,I)>IX(IJ,I+1) THEN GOTO 9240 ELSE GOTO 9270
  128. 9240   SWAP IX(IJ,I),IX(IJ,I+1)
  129. 9250   SWAP IY(IJ,I),IY(IJ,I+1)
  130. 9260 IPAS=1
  131. 9270 NEXT I
  132. 9280 WEND
  133. 9290 NEXT IJ
  134. 9300 RETURN
  135. 9310 '
  136. 9320 REM  Labeling and axis subroutine
  137. 9330 '
  138. 9340 PRINT: INPUT "enter y-axis label (12 characters)";YNA$
  139. 9350 INPUT "enter x-axis label (20 characters)";XNA$
  140. 9360 SCREEN 2: CLS
  141. 9370 LOCATE 24,30
  142. 9380 IF LEN(XNA$)>20 THEN PRINT LEFT$(XNA$,20); ELSE PRINT XNA$;
  143. 9390 FOR I=1 TO 12
  144. 9400   LOCATE (4+I),1: PRINT MID$(YNA$,I,1);
  145. 9410 NEXT I
  146. 9420 '
  147. 9430 PSET(68,164)
  148. 9440 FOR I=1 TO 5: DRAW "r112d4u4": NEXT I
  149. 9450 PSET(68,164)
  150. 9460 FOR I=1 TO 5: DRAW "u32l6r6": NEXT I
  151. 9470 '
  152. 9480 YINT=YRAN/5
  153. 9490 YLB(1)=YMN: YLB(6)=YMX
  154. 9500 FOR I=2 TO 5
  155. 9510   YLB(I)=(I-1)*YINT+YMN
  156. 9520 NEXT I
  157. 9530 XINT=XRAN/5
  158. 9540 XLB(1)=XMN: XLB(6)=XMX
  159. 9550 FOR I=2 TO 5
  160. 9560   XLB(I)=(I-1)*XINT+XMN
  161. 9570 NEXT I
  162. 9580 '
  163. 9590 FOR I=1 TO 6
  164. 9600   IP=21-(4*(I-1))
  165. 9610   LOCATE IP,3
  166. 9620   PRINT USING "###.#";YLB(I);
  167. 9630 NEXT I
  168. 9640 FOR I=1 TO 5
  169. 9650   IP=6+((I-1)*14)
  170. 9660   LOCATE 22,IP
  171. 9670   PRINT USING "#####";XLB(I);
  172. 9680   PRINT "         ";
  173. 9690 NEXT I
  174. 9700 PRINT USING "#####";XLB(6);
  175. 9710 RETURN
  176. 9720 '
  177. 9730 REM  PLOTTING SUBROUTINE
  178. 9740 '
  179. 9750 SYM$(1)="d2l3r6u1l6u1r6u1l6u1r6"
  180. 9760 SYM$(4)="u1r1l1d1l1r3d1r1l5"
  181. 9770 SYM$(3)="d1r2u1r1l4u1r4l1u1l2"
  182. 9780 SYM$(5)="bl2u2r6d4l6u2br2"
  183. 9790 SYM$(2)="e3g3h3f6h3g3e3"
  184. 9800 FOR IJ=1 TO IN
  185. 9810   PSET(IX(IJ,1),IY(IJ,1)): DRAW SYM$(IJ)
  186. 9820   FOR I=1 TO IND-1
  187. 9830       FOR IA=1 TO IND
  188. 9840       IF I+IA>IND THEN GOTO 9910
  189. 9850       IF IY(IJ,I+IA)>163 THEN GOTO 9860 ELSE GOTO 9870
  190. 9860       NEXT IA
  191. 9870     LINE(IX(IJ,I),IY(IJ,I))-(IX(IJ,I+IA),IY(IJ,I+IA))
  192. 9880     I=I+IA-1
  193. 9890     DRAW SYM$(IJ)
  194. 9900   NEXT I
  195. 9910 NEXT IJ
  196. 9920 RETURN
  197. J,I),IY(IJ,I))-(IX(IJ,I+IA),IY(IJ,I+IA))